home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / 1svga / sorts.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-20  |  3.5 KB  |  140 lines
  1. { Sorts & Search }
  2.  
  3. var Data:array[0..5000] of longint;
  4.  
  5. { ─────────────── BinarySearch ─────────────── }
  6. function BinSearch(Srh:longint;Start_,End_:integer):integer;
  7. var L,R,M:integer;
  8. begin
  9.   L:=Start_; R:=End_;
  10.   repeat
  11.     M:=(L+R) shr 1;
  12.     if Srh<Data[M] then R:=M-1 else if Srh>Data[M] then L:=M+1
  13.       else begin BinSearch:=M; Exit; end;
  14.   until L>R;
  15.   BinSearch:=-1;
  16. end;
  17. { ─────────────── BubbleSort ─────────────── }
  18. procedure BubbleSort(N:integer);
  19. var I,J:integer;
  20.     T:longint;
  21. begin
  22.   for I:=1 to N-1 do begin
  23.     J:=I;
  24.     while (J>0) and (Data[J]>Data[J+1]) do begin
  25.       T:=Data[J]; Data[J]:=Data[J+1]; Data[J+1]:=T;
  26.       Dec(J);
  27.     end;
  28.   end;
  29. end;
  30. { ─────────────── SelectSort ─────────────── }
  31. procedure SelectSort(N:integer);
  32. var I,J,K:integer;
  33.     T:longint;
  34. begin
  35.   for I:=1 to N-1 do begin
  36.     K:=I;
  37.     for J:=I+1 to N do if Data[K]>Data[J] then K:=J;
  38.     if I<>K then begin T:=Data[I]; Data[I]:=Data[k]; Data[K]:=T; end;
  39.   end;
  40. end;
  41. { ─────────────── InsertSort ─────────────── }
  42. procedure InsertSort(N:integer);
  43. var I,J:integer;
  44.     T:longint;
  45. begin
  46.   Data[0]:=-1;
  47.   for I:=2 to N do begin
  48.     T:=Data[I]; J:=I-1;
  49.     while T<Data[J] do begin Data[J+1]:=Data[J]; Dec(J) end;
  50.     Data[J+1]:=T;
  51.   end;
  52. end;
  53. { ─────────────── ShellSort ─────────────── }
  54. procedure ShellSort(N:integer);
  55. var I,J,Done:integer;
  56.     T:longint;
  57. begin
  58.   J:=N;
  59.   while J>1 do begin
  60.     J:=J shr 1;
  61.     repeat
  62.       Done:=1;
  63.       for I:=1 to N-J do if Data[I]>Data[I+J] then begin
  64.     T:=Data[I]; Data[I]:=Data[I+J]; Data[I+J]:=T;
  65.     Done:=0;
  66.       end;
  67.     until Done=1;
  68.   end;
  69. end;
  70. { ─────────────── HeapSort ─────────────── }
  71. procedure HeapSort(N:integer);
  72. procedure Adjust(I,N:integer);
  73. var J:integer;
  74.     T:longint;
  75. begin
  76.   T:=Data[I]; J:=I shl 1;
  77.   while J<=N do begin
  78.     if (J<N) and (Data[J]<Data[J+1]) then Inc(J);
  79.     if T>=Data[J] then begin Data[J shr 1]:=T; Exit; end
  80.       else begin Data[J shr 1]:=Data[J]; J:=J shl 1; end;
  81.   end;
  82.   Data[J shr 1]:=T;
  83. end;
  84. var I:integer;
  85.     T:longint;
  86. begin
  87.   for I:=N shr 1 downto 1 do Adjust(I,N);
  88.   for I:=N-1 downto 1 do begin
  89.     T:=Data[I+1]; Data[I+1]:=Data[1]; Data[1]:=T;
  90.     Adjust(1,I);
  91.   end;
  92. end;
  93. { ─────────────── QuickSort ─────────────── }
  94. procedure QuickSort(L,R:integer);
  95. var I,J:integer;
  96.     M,T:longint;
  97. begin
  98.   I:=L; J:=R; M:=Data[(L+R) shr 1];
  99.   repeat
  100.     while Data[I]<M do Inc(I);
  101.     while M<Data[J] do Dec(J);
  102.     if I<=J then begin
  103.       T:=Data[I]; Data[I]:=Data[J]; Data[J]:=T;
  104.       Inc(I); Dec(J);
  105.     end;
  106.   until I>J;
  107.   if L<J then QuickSort(L,J);
  108.   if I<R then QuickSort(I,R);
  109. end;
  110. { ─────────────── CombSort ─────────────── }
  111. procedure CombSort(N:integer);
  112. var I,Flag:integer;
  113.     T,Gap:longint;
  114. begin
  115.   Gap:=N;
  116.   repeat
  117.     Flag:=0; Gap:=Gap*10 div 13;
  118.     if Gap=0 then Gap:=1 else if (Gap=9) or (Gap=10) then Gap:=11;
  119.     for I:=1 to N-Gap do if Data[I]>Data[I+Gap] then
  120.       begin T:=Data[I]; Data[I]:=Data[I+Gap]; Data[I+Gap]:=T; Flag:=1; end;
  121.   until (Flag=0) and (Gap=1);
  122. end;
  123.  
  124. const St:array[1..4] of string[5]=('Quick',' Heap',' Comb','Shell');
  125. var I,L:longint;
  126. begin
  127.   Writeln; Writeln('Sorting 5000 long-integers...');
  128.   for I:=1 to 4 do begin
  129.     for L:=1 to 5000 do Data[L]:=Random(5000);
  130.     L:=MemL[0:$46C];
  131.     case I of
  132.       1:QuickSort(1,5000);
  133.       2:HeapSort(5000);
  134.       3:CombSort(5000);
  135.       4:ShellSort(5000);
  136.     end;
  137.     Writeln(St[I],MemL[0:$46C]-L:5,' 1/18.2sec');
  138.   end;
  139. end.
  140.